home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / mouse.swg / 0017_Full Featured Mouse Unit.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  15KB  |  457 lines
  1.  
  2.                     {MOUSE.PAS creates MOUSE.TPU Unit}
  3.      {From the book "OBJECT ORIENTED PROGRAMMING IN TURBO PASCAL 5.5"}
  4.  
  5. Unit Mouse;
  6.  
  7. Interface
  8.  
  9. Type
  10.     GCursor = record
  11.             ScreenMask,
  12.             CursorMask : array[0..15] of word;
  13.             hotX,hotY  : integer;
  14.             end; {record}
  15.  
  16.  
  17.                   {================================}
  18.                   {Graphics Cursors are predefined }
  19.                   {for use with GraphicMouse       }
  20.                   {================================}
  21.  
  22.  
  23. Const           {The graphics cursors are defined as constants       }
  24.  
  25.      HAMMER : GCursor =       {As in the hammer of THOR, my favorite}
  26.             (ScreenMask : ($8003,$0001,$0001,$1831,
  27.                            $1011,$0001,$0001,$8003,
  28.                            $F83F,$F83F,$F83F,$F83F,
  29.                            $F83F,$F83F,$F83F,$F83F);
  30.              CursorMask : ($0000,$3FF8,$4284,$4104,
  31.                            $4284,$4444,$3FF8,$0380,
  32.                            $0380,$0380,$0380,$0380,
  33.                            $0380,$0380,$0380,$0000);
  34.              HotX : $0007;
  35.              HotY : $0003);
  36.  
  37.      ARROW : GCursor =       {Your run-of-the-mill Graphics Arrow cursor}
  38.            (ScreenMask : ($1FFF,$0FFF,$07FF,$03FF,
  39.                           $01FF,$00FF,$007F,$003F,
  40.                           $001F,$003F,$01FF,$01FF,
  41.                           $E0FF,$F0FF,$F8FF,$F8FF);
  42.             CursorMask : ($0000,$4000,$6000,$7000,
  43.                           $7800,$7C00,$7E00,$7F00,
  44.                           $7F80,$7C00,$4C00,$0600,
  45.                           $0600,$0300,$0400,$0000);
  46.             HotX : $0001;
  47.             HotY : $0001);
  48.  
  49.      CHECK : GCursor =       {A check-mark cursor}
  50.            (ScreenMask : ($FFF0,$FFE0,$FFC0,$FF81,
  51.                           $FF03,$0607,$000F,$001F,
  52.                           $803F,$C07F,$E0FF,$F1FF,
  53.                           $FFFF,$FFFF,$FFFF,$FFFF);
  54.             CursorMask : ($0000,$0006,$000C,$0018,
  55.                           $0030,$0060,$70C0,$3980,
  56.                           $1F00,$0E00,$0400,$0000,
  57.                           $0000,$0000,$0000,$0000);
  58.             HotX : $0005;
  59.             HotY : $0010);
  60.  
  61.      CROSS : GCursor =       {A circle with center cross cursor}
  62.            (ScreenMask : ($F01F,$E00F,$C007,$8003,
  63.                           $0441,$0C61,$0381,$0381,
  64.                           $0381,$0C61,$0441,$8003,
  65.                           $C007,$E00F,$F01F,$FFFF);
  66.             CursorMask : ($0000,$07C0,$0920,$1110,
  67.                           $2108,$4004,$4004,$783C,
  68.                           $4004,$4004,$2108,$1110,
  69.                           $0920,$07C0,$0000,$0000);
  70.             HotX : $0007;
  71.             HotY : $0007);
  72.  
  73.      GLOVE : GCursor =       {The hand with pointing finger cursor}
  74.            (ScreenMask : ($F3FF,$E1FF,$E1FF,$E1FF,
  75.                           $E1FF,$E049,$E000,$8000,
  76.                           $0000,$0000,$07FC,$07F8,
  77.                           $9FF9,$8FF1,$C003,$E007);
  78.             CursorMask : ($0C00,$1200,$1200,$1200,
  79.                           $1200,$13B6,$1249,$7249,
  80.                           $9249,$9001,$9001,$8001,
  81.                           $4002,$4002,$2004,$1FF8);
  82.             HotX : $0004;
  83.             HotY : $0000);
  84.  
  85.      IBEAM : GCursor =       {Your normal text entering I shaped cursor}
  86.            (ScreenMask : ($F3FF,$E1FF,$E1FF,$E1FF,
  87.                           $E1FF,$E049,$E000,$8000,
  88.                           $0000,$0000,$07FC,$07F8,
  89.                           $9FF9,$8FF1,$C003,$E007);
  90.             CursorMask : ($0C30,$0240,$0180,$0180,
  91.                           $0180,$0180,$0180,$0180,
  92.                           $0180,$0180,$0180,$0180,
  93.                           $0180,$0180,$0240,$0C30);
  94.             HotX : $0007;
  95.             HotY : $0007);
  96.  
  97.       KKG : GCursor =     {KKG symbol, a little sorority stuff}
  98.         (ScreenMask : ($FFFF,$1040,$1040,$0000,
  99.                        $0000,$0000,$0411,$0411,
  100.                        $0001,$0001,$0001,$1041,
  101.                        $1041,$1041,$FFFF,$FFFF );
  102.          CursorMask : ($0000,$0000,$4517,$4515,
  103.                        $4925,$5144,$6184,$6184,
  104.                        $5144,$4924,$4514,$4514,
  105.                        $4514,$0000,$0000,$0000 );
  106.          HotX : $0007;
  107.          HotY : $0005);
  108.  
  109.       SMILEY : GCursor =  {a Smiley face for you!}
  110.         (ScreenMask : ($C003,$8001,$07E0,$0000,
  111.                        $0000,$0000,$0000,$0000,
  112.                        $0000,$0000,$0000,$8001,
  113.                        $C003,$C003,$E007,$F81F );
  114.          CursorMask : ($0FF0,$1008,$2004,$4002,
  115.                        $4E72,$4A52,$4E72,$4002,
  116.                        $4992,$581A,$2424,$13C8,
  117.                        $1008,$0C30,$03C0,$0000 );
  118.          HotX : $0007;
  119.          HotY : $0005);
  120.  
  121.       XOUT : GCursor =    {a BIG X marks the spot}
  122.         (ScreenMask : ($1FF8,$0FF0,$07E0,$03C0,
  123.                        $8181,$C003,$E007,$F00F,
  124.                        $F81F,$F00F,$E007,$C003,
  125.                        $8181,$03C0,$07E0,$0FF0 );
  126.          CursorMask : ($8001,$C003,$6006,$300C,
  127.                        $1818,$0C30,$0660,$03C0,
  128.                        $0180,$03C0,$0660,$0C30,
  129.                        $1818,$300C,$6006,$C003 );
  130.          HotX : $0007;
  131.          HotY : $0008);
  132.  
  133.       SWORD : GCursor =   {For the D&D buffs...}
  134.         (ScreenMask : ($F83F,$F83F,$F83F,$F83F,
  135.                        $F83F,$F83F,$F83F,$F83F,
  136.                        $8003,$8003,$8003,$8003,
  137.                        $8003,$F83F,$F01F,$F01F );
  138.          CursorMask : ($0100,$0380,$0380,$0380,
  139.                        $0380,$0380,$0380,$0380,
  140.                        $0380,$3398,$3398,$3FF8,
  141.                        $0380,$0380,$0380,$07C0 );
  142.          HotX : $0007;
  143.          HotY : $0000);
  144.  
  145.  
  146. Type
  147.     Position = record
  148.              btnStat,
  149.              opCount,
  150.              Xpos,Ypos : integer;
  151.              end; {record}
  152.  
  153. Const
  154.      ButtonL = 0;
  155.      ButtonR = 1;
  156.      ButtonM = 2;
  157.      Software = 0;
  158.      Hardware = 1;
  159.  
  160.      
  161. Type
  162.     GenMouse = object
  163.              X,Y : integer;
  164.              Visible : boolean;
  165.              Function TestMouse : boolean;
  166.              Procedure SetAccel(Threshold : integer);
  167.              Procedure Show(Option : boolean);
  168.              Procedure GetPosition(var BtnStatus,Xpos,Ypos : integer);
  169.              Procedure QueryBtnDn(Button : integer;var mouse : position);
  170.              Procedure QueryBtnUp(Button : integer;var mouse : position);
  171.              Procedure ReadMove(var XMove,YMove : integer);
  172.              Procedure Reset(var Status : boolean;var BtnCount : integer);
  173.              Procedure SetRatio(HorPix,VerPix : integer);
  174.              Procedure SetLimits(XPosMin,YPosMin,XPosMax,YPosMax : integer);
  175.              Procedure SetPosition(XPos,YPos : integer);
  176.              end; {object}
  177.  
  178.     GraphicMouse = object(GenMouse)
  179.                  Procedure Initialize;
  180.                  Procedure ConditionalHide(Left,Top,Right,Bottom : integer);
  181.                  Procedure SetCursor(Cursor : GCursor);
  182.                  end; {object}
  183.  
  184.     TextMouse = object(GenMouse)
  185.               Procedure Initialize;
  186.               Procedure SetCursor(Ctype,C1,C2 : word);
  187.               end; {object}
  188.  
  189.     GraphicLightPen = object(GraphicMouse)
  190.                     Procedure LightPen(Option : boolean);
  191.                     end; {object}
  192.  
  193.     TextLightPen = object(TextMouse)
  194.                  Procedure LightPen(Option : boolean);
  195.                  end; {object}
  196.  
  197. {=========================================================================}
  198.  
  199. Implementation
  200.  
  201. Uses
  202.     Crt,Graph,Dos;
  203. Var
  204.    Regs : registers;
  205.  
  206. {*************************************************************************}
  207.  
  208. Function Lower(N1,N2 : integer) : integer;
  209. Begin
  210.      if N1 < N2 then
  211.         Lower := N1
  212.      else
  213.          Lower := N2;
  214. End;
  215.  
  216. {*************************************************************************}
  217.  
  218. Function Upper(N1,N2 : integer) : integer;
  219. Begin
  220.      if N1 > N2 then
  221.         Upper := N1
  222.      else
  223.          Upper := N2;
  224. End;
  225.  
  226. {*************************************************************************}
  227.  
  228. Function GenMouse.TestMouse : boolean;
  229. Const
  230.      Iret = 207;
  231. Var
  232.    dOff,dSeg : integer;
  233. Begin
  234.      dOff := MemW[0000:0204];
  235.      dSeg := MemW[0000:0206];
  236.      if ((dSeg = 0) or (dOff = 0)) then
  237.         TestMouse := False
  238.      else
  239.          TestMouse := Mem[dSeg:dOff] <> Iret;
  240. End;
  241.  
  242. {*************************************************************************}
  243.  
  244. Procedure GenMouse.Reset(var Status : boolean; var BtnCount : integer);
  245. Begin
  246.      Regs.AX := $00;            {Reset to default conditions}
  247.      intr($33,Regs);
  248.      Status := Regs.AX <> 0;    {Mouse Present}
  249.      BtnCount := Regs.BX;       {Button Count}
  250. End;
  251.  
  252. {*************************************************************************}
  253.  
  254. Procedure GenMouse.SetAccel(Threshold : integer);
  255. Begin
  256.      Regs.AX := $13;
  257.      Regs.DX := Threshold;
  258.      Intr($33,Regs);
  259. End;
  260.  
  261. {*************************************************************************}
  262.  
  263. Procedure GenMouse.Show(Option : boolean);
  264. Begin
  265.      if Option and not Visible then
  266.      begin
  267.           Regs.AX := $01;         {Show mouse cursor}
  268.           Visible := True;
  269.           Intr($33,Regs);
  270.      end
  271.      else
  272.      if Visible and not Option then
  273.      begin
  274.           Regs.AX := $02;           {Hide mouse cursor}
  275.           Visible := False;
  276.           Intr($33,Regs);
  277.      end;
  278. End;
  279.  
  280. {*************************************************************************}
  281.  
  282. Procedure GenMouse.GetPosition(var BtnStatus,Xpos,Ypos : integer);
  283. Begin
  284.      Regs.AX := $03;
  285.      Intr($33,Regs);
  286.      BtnStatus := Regs.BX;
  287.      Xpos      := Regs.CX;
  288.      Ypos      := Regs.DX;
  289. End;
  290.  
  291. {*************************************************************************}
  292.  
  293. Procedure GenMouse.SetPosition(Xpos,Ypos : integer);
  294. Begin
  295.      Regs.AX := $04;
  296.      Regs.CX := Xpos;
  297.      Regs.DX := Ypos;
  298.      Intr($33,Regs);
  299. End;
  300.  
  301. {*************************************************************************}
  302.  
  303. Procedure GenMouse.SetRatio(HorPix,VerPix : integer);
  304. Begin
  305.      Regs.AX := $0F;
  306.      Regs.CX := HorPix;         {horizonal mickeys/pixel}
  307.      Regs.DX := VerPix;         {vertical mickeys/pixel}
  308.      Intr($33,Regs);
  309. End;
  310.  
  311. {*************************************************************************}
  312.  
  313. Procedure GenMouse.QueryBtnDn(Button : integer;var Mouse : position);
  314. Begin
  315.      Regs.AX := $05;
  316.      Regs.BX := Button;
  317.      Intr($33,Regs);
  318.      Mouse.BtnStat := Regs.AX;
  319.      Mouse.OpCount := Regs.BX;
  320.      Mouse.Xpos    := Regs.CX;
  321.      Mouse.Ypos    := Regs.DX;
  322. End;
  323.  
  324. {*************************************************************************}
  325.  
  326. Procedure GenMouse.QueryBtnUp(Button : integer;var Mouse : position);
  327. Begin
  328.      Regs.AX := $06;
  329.      Regs.BX := Button;
  330.      Intr($33,Regs);
  331.      Mouse.BtnStat := Regs.AX;
  332.      Mouse.OpCount := Regs.BX;
  333.      Mouse.Xpos    := Regs.CX;
  334.      Mouse.Ypos    := Regs.DX;
  335. End;
  336.  
  337. {*************************************************************************}
  338.  
  339. Procedure GenMouse.SetLimits(XPosMin,YPosMin,XPosMax,YPosMax : integer);
  340. Begin
  341.      Regs.AX := $07;    {horizonal limits}
  342.      Regs.CX := Lower(XPosMin,XPosMax);
  343.      Regs.DX := Upper(XPosMin,XPosMax);
  344.      Intr($33,Regs);
  345.      Regs.AX := $08;    {vertical limits}
  346.      Regs.CX := Lower(YPosMin,YPosMax);
  347.      Regs.DX := Upper(YPosMin,YPosMax);
  348.      Intr($33,Regs);
  349. End;
  350.  
  351. {*************************************************************************}
  352.  
  353. Procedure GenMouse.ReadMove(var XMove,YMove : integer);
  354. Begin
  355.      Regs.AX := $0B;
  356.      Intr($33,Regs);
  357.      XMove := Regs.CX;
  358.      YMove := Regs.DX;
  359. End;
  360.  
  361. {*************************************************************************}
  362.  
  363.              {=======================================}
  364.              {Implementation methods for GraphicMouse}
  365.              {=======================================}
  366.  
  367. Procedure GraphicMouse.SetCursor(Cursor : GCursor);
  368. Begin
  369.      Regs.AX := $09;
  370.      Regs.BX := Cursor.HotX;
  371.      Regs.CX := Cursor.HotY;
  372.      Regs.DX := Ofs(Cursor.ScreenMask);
  373.      Regs.ES := Seg(Cursor.ScreenMask);
  374.      Intr($33,Regs);
  375. End;
  376.  
  377. {*************************************************************************}
  378.  
  379. Procedure GraphicMouse.ConditionalHide(Left,Top,Right,Bottom : integer);
  380. Begin
  381.      Regs.AX := $0A;
  382.      Regs.CX := Left;
  383.      Regs.DX := Top;
  384.      Regs.SI := Right;
  385.      Regs.DI := Bottom;
  386.      Intr($33,Regs);
  387. End;
  388.  
  389. {*************************************************************************}
  390.  
  391. Procedure GraphicMouse.Initialize;
  392. Begin
  393.      Visible := False;
  394.      SetLimits(0,0,GetMaxX,GetMaxY);
  395.      SetCursor(Arrow);
  396.      SetPosition(GetMaxX div 2,GetMaxY div 2);
  397.      Show(True);
  398. End;
  399.  
  400. {*************************************************************************}
  401.  
  402.                     {====================================}
  403.                     {Implementation methods for TextMouse}
  404.                     {====================================}
  405.  
  406. Procedure TextMouse.Initialize;
  407. Begin
  408.      Visible := False;
  409.      SetLimits(Lo(WindMin)*8,Hi(WindMin)*8,Lo(WindMax)*8,Hi(WindMax)*8);
  410.      SetCursor(Hardware,6,7);
  411.      SetPosition(0,0);
  412.      Show(True);
  413. End;
  414.  
  415. {*************************************************************************}
  416.  
  417. Procedure TextMouse.SetCursor(CType,C1,C2 : word);
  418. Begin
  419.      Regs.AX := $0A;            {function 10h}
  420.      Regs.BX := CType;          {0=software,1=hardware}
  421.      Regs.CX := C1;             {screen mask or scan start line}
  422.      Regs.DX := C2;             {screen mask or scan stop line}
  423.      Intr($33,Regs);
  424. End;
  425.  
  426. {*************************************************************************}
  427.  
  428.              {===================================}
  429.              {Implementation methods for LightPen}
  430.              {===================================}
  431.  
  432. Procedure TextLightPen.LightPen(Option : boolean);
  433. Begin
  434.      if Option then
  435.         Regs.AX := $0D
  436.      else
  437.          Regs.AX := $0E;
  438.      Intr($33,Regs);
  439. End;
  440.  
  441. {*************************************************************************}
  442.  
  443. Procedure GraphicLightPen.LightPen(Option : boolean);
  444. Begin
  445.      if Option then
  446.         Regs.AX := $0D
  447.      else
  448.          Regs.AX := $0E;
  449.      Intr($33,Regs);
  450. End;
  451.  
  452. {*************************************************************************}
  453.  
  454. BEGIN
  455. END.
  456.  
  457.